home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / contrib / zelk / src-zelk / forgl.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-12  |  8.2 KB  |  336 lines
  1. /* forgl.c zilla 23apr - export some of SGI GL graphics library to scheme
  2.  * mod 12nov,26sep,22sep
  3.  *
  4.  * distinguish our additional or higher level functions by naming them
  5.  * like gl-word-word naming, versus gl-wordword for a pure gl library function.
  6.  *
  7.  ****NOTE THE ELK COPYING GC: ALL Object REFERENCES MUST BE GC_LINKED
  8.  ****ACROSS CALLS WHICH MAY ALLOCATE STORAGE.  ALL C VARIABLES WHICH 
  9.  ****ARE ASSIGNED FROM THE ADDRESS OF AN OBJECT MUST BE REASSIGNED
  10.  ****AFTER A GC.
  11.  * 
  12.  * Routines which expect char,short can be successfully declared
  13.  * as having int foreign args.  Float/double distinction is tricky however.
  14.  * Under ansi C, any function which is declared in prototype style
  15.  * (presumably including gl library calls) will take and return
  16.  * Floats, not doubles.  Functions which have prototypes but
  17.  * which are themselves declared in the traditional style will
  18.  * take doubles but return floats.
  19.  * Under sgi traditional C, all functions with prototypes will
  20.  * take/return floats, regardless of how the function itself is declared.
  21.  */
  22.  
  23. #include <theusual.h>
  24.  
  25. #if Esgi
  26.  
  27. /* THIS FILE is difficult to compile.  There is a conflict between
  28.  * gl.h Object and scheme.h Object.  It compiled ok with -cckr,
  29.  * but we want to use the new ansi definition macro GLFUNC().
  30.  * Without -cckr, need to define -DSgiAnsi for theusual.h to work.
  31.  * Then, gl.h Object conflicts.  solution--had to #define _XtObject_h,
  32.  * this seems? to fix things.
  33.  */
  34.  
  35. #ifdef _GL_UNDEF_TYPES
  36. : error gl-undef
  37. #endif
  38.  
  39. #define _XtObject_h
  40. #include <gl/gl.h>
  41. #include <gl/device.h>
  42.  
  43. #ifdef Object
  44.   : error Object
  45. #endif
  46.  
  47. #include <scheme.h>
  48. #include <zelk.h>
  49.  
  50. /* return mouse x as fraction of window size */
  51. #define MOUSEFX { "gl-mouse-fx", (vfunction *)gl_mouse_fx, "Rf" } ,
  52. float gl_mouse_fx()
  53. {
  54.   long ox,oy,sx,sy;
  55.   getorigin(&ox,&oy);
  56.   getsize(&sx,&sy);
  57.   return (float)(getvaluator(MOUSEX)-ox) / (float)(sx - EfloatC(1.));
  58. }
  59.  
  60.  
  61. /* return mouse y as fraction of window size */
  62. #define MOUSEFY { "gl-mouse-fy", (vfunction *)gl_mouse_fy, "Rf" } ,
  63. float gl_mouse_fy()
  64. {
  65.   long ox,oy,sx,sy;
  66.   getorigin(&ox,&oy);
  67.   getsize(&sx,&sy);
  68.   return (float)(getvaluator(MOUSEY)-oy) / (float)(sy - EfloatC(1.));
  69. }
  70.  
  71.  
  72. /* read the event queue */
  73. #define QREAD Pqread, "gl-qread", 0,0,EVAL,
  74. extern Object P_Cons Zproto((Object,Object));
  75.  
  76. static Object Pqread()
  77. {
  78.   long devid;
  79.   short data;
  80.   Object Ocar,Ocdr,Ocons;
  81.   GC_Node2;
  82.  
  83.   devid = qread(&data);
  84.   GC_Link2(Ocar,Ocdr);
  85.   Ocar = Make_Integer(devid);
  86.   Ocdr = Make_Integer((int4)data);
  87.   Ocons = P_Cons(Ocar,Ocdr);
  88.   GC_Unlink;
  89.  
  90.   return Ocons;
  91. } /*Pqread*/
  92.  
  93.  
  94. #define GETSIZE { "gl-getsize", (vfunction *)Pgetsize, "A" } ,
  95. static void Pgetsize(long s[2])
  96. {   getsize(&(s[0]),&(s[1]));  }
  97.  
  98.  
  99. #define GETORIGIN { "gl-getorigin", (vfunction *)Pgetorigin, "A" } ,
  100. static void Pgetorigin(long s[2])
  101. {   getorigin(&(s[0]),&(s[1]));  }
  102.  
  103.  
  104. /* ansi version of a macro which automatically adds the prefix gl- */
  105. #define GLFUNC(name,args) \
  106. { "gl-" # name , (vfunction *)name, args } ,
  107.  
  108. /* attempt at K&R C version of this macro
  109. #define GLFUNC(name,args) \
  110. { "gl-name", (vfunction *)name, args } ,
  111. */
  112.  
  113.  
  114. #ifdef ZILLAONLY
  115. /* some test functions */
  116.  
  117. #include <VF.h>
  118. unsigned long octcolor[6] = {
  119.     0xff0000,            /* [0] = blue */
  120.     0x00ff00,            /* [1] = green */
  121.     0x0000ff,            /* [2] = red */
  122.     0xff00ff,                /* [3] = magenta */
  123.     0xffff00,            /* [4] = cyan */
  124.     0xffffff,            /* [5] = white */
  125. };
  126.  
  127.  
  128. #define DRAWSTRIP  GLFUNC(drawstrip,"AAI")
  129. static void
  130. drawstrip(row1,row2,stride)
  131.   float *row1,*row2;
  132.   register int stride;
  133. {
  134.   register int i;
  135.   register int len;
  136.   Ztrace(("drawstrip: %.2f %.2f %.2f \n",
  137.           row1[0],row1[1],row1[2]));
  138.   Ztrace(("         : %.2f %.2f %.2f...\n",
  139.           row2[0],row2[1],row2[2]));
  140.  
  141.   len = VFlen((VF)row1);
  142.   if (VFlen((VF)row2) != len) Panic("drawstrip-length mismatch");
  143.  
  144.   bgnqstrip();
  145.   shademodel(GOURAUD);
  146.   len /= 3;
  147.   for( i=0; i < len; i++ ) {
  148. /* cpack(octcolor[i%8]); */
  149.  
  150.     v3f(row1);  v3f(row2);
  151.     row1 += stride;
  152.     row2 += stride;
  153.   }
  154.   endqstrip();
  155.   Ztrace(("--drawstrip\n"));
  156. } /*drawstrip*/
  157.  
  158.  
  159. /* drawstrip with corresponding packed colors */
  160. #define DRAWSTRIPCP  GLFUNC(drawstrip_cp,"AAIA")
  161. static void
  162. drawstrip_cp(row1,row2,stride,cp)
  163.   float *row1,*row2;
  164.   register int stride;
  165.   int *cp;
  166. {
  167.   register int i;
  168.   register int len;
  169.   Ztrace(("drawstrip: %.2f %.2f %.2f \n",
  170.           row1[0],row1[1],row1[2]));
  171.   Ztrace(("         : %.2f %.2f %.2f...\n",
  172.           row2[0],row2[1],row2[2]));
  173.  
  174.   len = VFlen((VF)row1);
  175.   if (VFlen((VF)row2) != len) Panic("drawstrip-length mismatch");
  176.  
  177.   bgnqstrip();
  178.   shademodel(GOURAUD);
  179.   len /= 3;
  180.   for( i=0; i < len; i++ ) {
  181.     cpack(*cp); cp++;
  182.  
  183.     v3f(row1);  v3f(row2);
  184.     row1 += stride;
  185.     row2 += stride;
  186.   }
  187.   endqstrip();
  188.   Ztrace(("--drawstrip\n"));
  189. } /*drawstrip-cp*/
  190. #endif /*ZILLAONLY*/
  191.  
  192.  
  193.  
  194.  
  195.  
  196. static struct fordef ftab[] = {
  197.  
  198. /* window constraints */
  199.   GLFUNC(foreground,"")         /* check if obsolete? */
  200.   GLFUNC(prefsize,  "II")
  201.   GLFUNC(prefposition,"IIII")   /*x,dx,y,dy?*/
  202.  
  203. /* general window */
  204.   GLFUNC(winopen,"SRI")         /* returns a gid */
  205.   GLFUNC(wintitle,"S")
  206.   GLFUNC(winconstraints,"")     /* bind new constraints after creation */
  207.   GLFUNC(reshapeviewport,"")    /* sets view to dimensions of window */
  208.                                 /* call whenever window size changes */
  209.   GLFUNC(winset,"I")
  210.   GLFUNC(winclose,"I")
  211.   GETSIZE
  212.   GETORIGIN
  213.  
  214.   GLFUNC(winpop,"")
  215.   GLFUNC(RGBmode,"")
  216.   GLFUNC(doublebuffer,"")  
  217.   GLFUNC(swapbuffers,"")  
  218.   GLFUNC(zbuffer,"B")
  219.   GLFUNC(gconfig,"")
  220.   GLFUNC(setmonitor,"I")
  221.   
  222.   GLFUNC(gexit,     "")
  223.   GLFUNC(gflush,    "")
  224.   GLFUNC(clear,     "")
  225.   GLFUNC(czclear,   "II")       /* u_long color, long zval */
  226.   GLFUNC(zclear,    "")
  227.   GLFUNC(getgdesc,  "IRI")      /* long,long */
  228.  
  229. /* input */
  230.   GLFUNC(curson,    "") 
  231.   GLFUNC(cursoff,   "") 
  232.  
  233.   GLFUNC(qreset,    "")
  234.   GLFUNC(qdevice,   "I")  /*u_short*/
  235.   GLFUNC(qtest,     "RI") /*long*/
  236.   GLFUNC(getvaluator,"IRI")
  237.   MOUSEFX
  238.   MOUSEFY
  239.  
  240. /* menus */
  241.   GLFUNC(defpup,    "SRI") /* TEMPORARY!! defpup can have args! */
  242.   GLFUNC(freepup,   "I")
  243.   GLFUNC(addtopup,  "IS")
  244.   GLFUNC(dopup,     "IRI")
  245.  
  246. /* text */
  247.   GLFUNC(cmov2,     "ff") /* 2d position for next string*/
  248.   GLFUNC(charstr,   "S")  /* draw string at current position */
  249.  
  250. /* views */
  251.   GLFUNC(ortho2,    "ffff")     /* l,r,b,t !! */
  252.   GLFUNC(ortho,    "ffffff")
  253.   GLFUNC(perspective,"Ifff") /*angle is short*/
  254.   GLFUNC(polarview,"fIII")  /* dist, azimuth,incidence,twist */
  255.  
  256. /* colors */
  257.   GLFUNC(color,     "I") /*integer predefined color e.g. 7=white*/
  258.   GLFUNC(c3i,       "A") /*RGB 0..255*/
  259.   GLFUNC(c3f,       "A") /*RGB 0..1*/
  260.   GLFUNC(cpack,     "I") /*32bit packed*/
  261.   GLFUNC(lmdef,     "IIIA")  /*deftype,index,n, float props[]*/
  262.   GLFUNC(lmbind,    "II") /*short target,index*/
  263. #ifdef no  /* this is in "libgutil". */
  264.   GLFUNC(grey,      "fRI"); /*sets current color to this greylevel, */
  265.                             /*returns colorindex*/
  266. #endif
  267.  
  268. /* 2d drawing */
  269.   GLFUNC(rect,      "ffff") /* outline rectangle x1,y1, x2,y2 */
  270.   GLFUNC(rectf,     "ffff") /* filled rectangle x1,y1, x2,y2 */
  271.  
  272.   GLFUNC(bgnline,   "")
  273.   GLFUNC(endline,   "")
  274.  
  275. /* 3d drawing */
  276.   GLFUNC(bgnpolygon,   "")
  277.   GLFUNC(endpolygon,   "")
  278.   GLFUNC(bgnqstrip,   "")
  279.   GLFUNC(endqstrip,   "")
  280.   GLFUNC(v2i,       "A")
  281. /*  GLFUNC(v3i,       "A") */
  282.   GLFUNC(v2f,       "A")
  283.   GLFUNC(v3f,       "A")
  284.   GLFUNC(n3f,       "A")
  285.   GLFUNC(v4f,       "A")
  286.  
  287. # ifdef ZILLAONLY
  288.     DRAWSTRIP
  289.     DRAWSTRIPCP
  290. # endif
  291.  
  292. /* shading, lighting */ 
  293.   GLFUNC(shademodel,"I")
  294.  
  295. /* matrices */
  296.   GLFUNC(pushmatrix,"")
  297.   GLFUNC(popmatrix,"")
  298.   GLFUNC(loadmatrix,"A")
  299.   GLFUNC(getmatrix,"A")
  300.   GLFUNC(multmatrix,"A")        /* CTM = A*CTM */
  301.   GLFUNC(mmode,"I")             /* matrix mode: SINGLE(default),... */
  302.  
  303. /* xforms */
  304.   GLFUNC(translate, "fff")
  305.   GLFUNC(scale,     "fff")
  306.   GLFUNC(rot,       "fI")  /*,char*/
  307.  
  308.   {(char *)0, (vfunction *)0, (char *)0}
  309. };
  310.  
  311.  
  312.  
  313. static struct primdef Prims[] = {
  314.   QREAD
  315.   (Object (*)())0, (char *)0, 0,0,EVAL
  316. };
  317.  
  318.  
  319. /*global*/ FORPKG0 pkg_GL = {
  320.     0,                        /*packagetype. 0=current*/
  321.     (int (*)())0,                /*init_*/
  322.     0,                        /*stab,*/
  323.     (struct fordef *)ftab,            /*ftab,*/
  324.     (struct fordef_usage *)0            /*futab,*/
  325. };
  326.  
  327.  
  328. void Init_gl()
  329. {
  330.   Zforpkginit("pkg_GL",(PKG_type *)&pkg_GL);
  331.   ZLprimdeftab(Prims);
  332. }
  333.  
  334.  
  335. #endif /*Esgi*/
  336.